home *** CD-ROM | disk | FTP | other *** search
/ Run Magazine ReRun 1987 May & June / rerun-1987-05-06.d64 / puzzler's choice (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  13KB  |  389 lines
  1. 10 rem - puzzler's choice for c=64
  2. 20 rem - daniel miller
  3. 30 rem - astoria, n.y.   11103
  4. 40 rem - 4/19/86
  5. 50 vo=54296:wv=54276:at=54277:hi=54273:lo=54272:mv=0:goto110
  6. 60 poke781,p/40:poke782,p-40*peek(781):poke783,0:sys65520:return
  7. 65 poke785,232:poke786,7:poke209,232:poke210,7:poke211,0:poke213,39
  8. 66 print" s&$[146][223]hd[146][193]$[146][160]d[146][194][160]":pokerl,peek(rl):rl=usr(rl):return
  9. 70 pokevo,15:pokewv,17:pokeat,15:pokehi,68:pokelo,149
  10. 80 fortm=1to100:next:pokewv,0
  11. 90 pokevo,15:pokewv,17:pokeat,15:pokehi,34:pokelo,75
  12. 100 fortm=1to100:next:pokewv,0:return
  13. 110 poke53280,2:poke53281,0:poke646,1
  14. 120 print"[147]":p=53:gosub60:print"puzzler's choice[146]":print
  15. 130 p=170:gosub60:print"select choice:":print
  16. 140 print"     1. alphabet puzzle":print"     2. juggernaut":
  17. 150 print"     3. checkers switch":print"     4. end program":print
  18. 160 printtab(15)" enter (1-4): ";:ct=fre(0)
  19. 170 getch$:ifch$<"1"orch$>"4"then170
  20. 180 printch$:on val(ch$)goto200,1420,2510,190
  21. 190 end
  22. 200 dima$(16),b$(16),lt$(16),lu$(16),a(16),d1$(4,4)
  23. 210 aa=0:l2=rnd(-ti):x1=16:goto1230
  24. 220 print"[147]":poke53281,11
  25. 230 p=54:gosub60:print"alphabet puzzle[146]":print:ct=fre(0)
  26. 240 rem - puzzle screen
  27. 250 p=120:gosub60:print"";
  28. 260 printtab(15)a$(1);"[145][145]"a$(2);"[145][145]"a$(3);"[145][145]"a$(4)
  29. 270 printtab(15)a$(5);"[145][145]"a$(6);"[145][145]"a$(7);"[145][145]"a$(8)
  30. 280 printtab(15)a$(9);"[145][145]"a$(10);"[145][145]"a$(11);"[145][145]"a$(12)
  31. 290 printtab(15)a$(13);"[145][145]"a$(14);"[145][145]"a$(15);"[145][145]"a$(16)
  32. 300 ifmv>0thengosub70
  33. 310 ifaa=0then330
  34. 320 onaa-1 goto610,750,820
  35. 330 p=686:gosub60:print" your goal in this puzzle is to"
  36. 340 print" rearrange the letters on the playing"
  37. 350 print" board into order to be displayed on"
  38. 360 print" the screen."
  39. 370 p=926:gosub60:print"[158]press <return> to continue[146]";
  40. 380 wait 198,1:get rt$
  41. 390 fory=17to24:poke781,y:sys59903:next
  42. 400 p=682:gosub60:print"  there are more than ten trillion"
  43. 410 print" letter combinations.":print
  44. 420 print"   press 'f7' to end the puzzle.":print
  45. 430 printtab(14)"happy puzzling !";
  46. 440 fortm=1to4000:nexttm
  47. 450 fory=17to24:poke781,y:sys59903:next
  48. 460 p=844:gosub60:print"[159]press <return> to scramble letters[146]";:poke198,0
  49. 470 wait 198,1:get rt$
  50. 480 rt$="":poke781,21:sys59903
  51. 490 rem - scramble letters on puzzle screen
  52. 500 forx=1to16:a(x)=0:nextx
  53. 510 forlt=1to16:lt$(lt)=mid$(d$,lt,1):nextlt
  54. 520 l1=1
  55. 530 forll=1to16
  56. 540 l2=int(16*rnd(1))+1
  57. 550 ifa(l2)>0then540
  58. 560 lu$(l1)=lt$(l2):a(l2)=l2:l1=l1+1:nextll
  59. 570 d$="":forx=1to16:d$=d$+lu$(x):nextx
  60. 580 forx=1to16:lt$(x)="":a(x)=0:nextx
  61. 590 aa=2:goto1240
  62. 600 rem - is arrangement possible ?
  63. 610 ct=0:z=1:fory=1to16
  64. 620 forx=zto15:ifmid$(d$,x+1,1)<lu$(z)thenct=ct+1
  65. 630 nextx:z=z+1:nexty
  66. 640 iflu$(2)="p"orlu$(4)="p"orlu$(5)="p"orlu$(7)="p"thenct=ct+1:goto660
  67. 650 iflu$(10)="p"orlu$(12)="p"orlu$(13)="p"orlu$(15)="p"thenct=ct+1
  68. 660 poke781,18:sys59903
  69. 670 rem - ct:even - yes; ct:odd - no
  70. 680 ifct/2=int(ct/2)then700
  71. 690 goto500
  72. 700 e$="":forx=1to16:e$=e$+lu$(x):nextx:rem - solution format
  73. 710 p=970:gosub60:print"[159]press <return> to begin[146]";
  74. 720 wait 198,1:get rt$
  75. 730 poke781,21:sys59903:poke781,24:sys59903:rt$=""
  76. 740 aa=3:goto1230
  77. 750 forx=1to16:iflu$(x)="p"thenlu$(x)="[158] [146][159]":goto770
  78. 760 nextx
  79. 770 p=270:gosub60:print"[159]solve[146]"
  80. 780 p=350:gosub60:printlu$(1);" ";lu$(2);" ";lu$(3);" ";lu$(4)
  81. 790 printtab(30);lu$(5);" ";lu$(6);" ";lu$(7);" ";lu$(8)
  82. 800 printtab(30);lu$(9);" ";lu$(10);" ";lu$(11);" ";lu$(12)
  83. 810 printtab(30);lu$(13);" ";lu$(14);" ";lu$(15);" ";lu$(16)
  84. 820 ifd$=e$then1100:rem - puzzle solved
  85. 830 forx=1to16:lt$(x)=mid$(d$,x,1):next x
  86. 840 x=1:forro=1to4:forcl=1to4:d1$(ro,cl)=mid$(d$,x,1):x=x+1:nextcl,ro
  87. 850 forro=1to4:forcl=1to4:ifd1$(ro,cl)="p" thenr1=ro:c1=cl
  88. 860 nextcl,ro:p=852:gosub60:print"press 'f7' to end"
  89. 870 p=696:gosub60:print"letter ?[159] [146]";:poke198,0
  90. 880 getlt$:iflt$=""then880
  91. 890 iflt$="[136]"then1210
  92. 900 iflt$<"a"orlt$>"o"thenlt$="":goto880
  93. 910 print"";lt$;
  94. 920 forro=1to4:forcl=1to4:ifd1$(ro,cl)=lt$then r2=ro:c2=cl
  95. 930 nextcl,ro
  96. 940 ifabs(r1-r2)=1 and abs(c1-c2)=1 then960
  97. 950 ifsqr((r1-r2)^2+(c1-c2)^2)=1 then990
  98. 960 forx=1to5:p=935:gosub60:print"invalid move[146]";:fortm=1to500:nexttm
  99. 970 poke781,23:sys59903:fortm=1to500:nexttm,x
  100. 980 p=705:gosub60:print" ";:goto870
  101. 990 forx=1to16:iflt$(x)=lt$thenx1=x
  102. 1000 nextx
  103. 1010 forx=1to16:iflt$(x)="p"thenx2=x
  104. 1020 nextx
  105. 1030 lt$(x1)="p":lt$(x2)=lt$
  106. 1040 d$="":forx=1to16:d$=d$+lt$(x):nextx
  107. 1050 p=705:gosub60:print"  ";
  108. 1060 p=776:gosub60:print"[158]move # [146]";
  109. 1070 mv=mv+1:p=782:gosub60:print"[158]";str$(mv)"[146]";
  110. 1080 aa=4:goto1240
  111. 1090 rem - end puzzle
  112. 1100 p=808:gosub60:print"you've solved the puzzle![146]";
  113. 1110 forcl=lo to lo+24:pokecl,0:next
  114. 1120 pokelo+5,85:pokelo+6,85:pokelo+12,85:pokelo+13,85:pokelo+24,15
  115. 1130 pokelo+4,33:pokelo+11,17:rl=1190:gosub65
  116. 1140 forx=1to6:readh1,l1,h2,l2:pokelo,l1:pokelo+1,h1:pokelo+7,l2:pokelo+8,h2
  117. 1150 ifh1=50thenfortm=1to200:nexttm
  118. 1160 fortm=1to100:nexttm
  119. 1170 nextx
  120. 1180 forcl=lo to lo+24:pokecl,0:next
  121. 1190 data25,30,18,209,33,135,25,30,42,62,31,165,50,60,37,162,42,62,31,165
  122. 1200 data50,60,37,162
  123. 1210 p=927:gosub60:print"[159]thanks for playing.  'bye'.[146]";
  124. 1220 fortm=1to1500:nexttm:poke198,0:run
  125. 1230 d$="abcdefghijklmnop":rem - puzzle format
  126. 1240 forx=1to16:ifmid$(d$,x,1)="p" thenx1=x
  127. 1250 nextx:ifmv=0then1280
  128. 1260 forx=1to16:ifmid$(d$,x,1)=lt$ then a=asc(lt$)-64:a$=lt$:goto1300
  129. 1270 nextx
  130. 1280 forx=1to16:a$(x)=""
  131. 1290 a$=mid$(d$,x,1)
  132. 1300 b=(a$="a")+(a$="c")+(a$="f")+(a$="h")+(a$="i")+(a$="k")+(a$="n")
  133. 1305 b=-1320*(b=-1)-1350*(b=0)
  134. 1310 poke785,188:poke786,168:pokeb,peek(b):b=usr(0)
  135. 1320 a$(x)="[166][166][166][157][157][157][166][146]"+a$+"[166][157][157][157][166][166][166][146]":rem "[166]" is 'c= +' [chr$(166)]
  136. 1330 ifmv>0then1380
  137. 1340 nextx:goto1380
  138. 1350 a$(x)="   [157][157][157] [146]"+a$+" [157][157][157]   [146]"
  139. 1360 ifmv>0then1380
  140. 1370 nextx
  141. 1380 a$(x1)="[158]   [157][157][157]   [157][157][157]   [146]"
  142. 1390 ifaa=0then220
  143. 1400 goto230
  144. 1410 rem - juggernaut main loop
  145. 1420 dim lc%(10),ch$(10),sp(2),sp$(10):goto2400
  146. 1430 p=788:gosub60:print" [157]";:ct=fre(0):poke198,0
  147. 1440 getmv$:forx=1to11:ifmv$=mid$("[133][136]abcdefghi",x,1)then1460
  148. 1450 next:goto1440
  149. 1460 ifmv$="[136]"then1800
  150. 1470 if mv$<>"[133]"then1500
  151. 1480 sol=1:s=0:mv=0:sol$="beha":goto2420
  152. 1490 s=s+1:mv$=mid$(sol$,s,1)
  153. 1500 p=788:gosub60:print mv$
  154. 1510 if ch$(asc(mv$)-64)<>"x" and ch$(asc(mv$)-63)<>"x" then1530
  155. 1520 msg$="invalid move[146]":p1=855:gosub1860:goto1430
  156. 1530 for x=1 to 10:if ch$(x)="x" thenlc=x:ld=x+1:goto1550
  157. 1540 next
  158. 1550 sp(1)=asc(mv$)-64:sp(2)=asc(mv$)-63
  159. 1560 rem - move checkers
  160. 1570 for y=ly% to lz% step-1
  161. 1580 pokev+val(sp$(sp(2))),y:pokev+val(sp$(sp(1))),y:next
  162. 1590 if sp(1)>lc then1640
  163. 1600 for x=lx%(sp(2)) to lx%(ld)
  164. 1610 pokev+val(sp$(sp(2)))-1,x:next
  165. 1620 for x=lx%(sp(1)) to lx%(lc)
  166. 1630 pokev+val(sp$(sp(1)))-1,x:next:goto1680
  167. 1640 for x=lx%(sp(1)) to lx%(lc) step-1
  168. 1650 pokev+val(sp$(sp(1)))-1,x:next
  169. 1660 for x=lx%(sp(2)) to lx%(ld) step-1
  170. 1670 pokev+val(sp$(sp(2)))-1,x:next
  171. 1680 for y=lz% to ly%
  172. 1690 pokev+val(sp$(sp(2))),y:pokev+val(sp$(sp(1))),y:next
  173. 1700 rem - update arrays & move-ctr
  174. 1710 ch$(lc)=ch$(sp(1)):ch$(ld)=ch$(sp(2)):ch$(sp(1))="x":ch$(sp(2))="x"
  175. 1720 sp$(lc)=sp$(sp(1)):sp$(ld)=sp$(sp(2)):sp$(sp(1))="xx":sp$(sp(2))="xx"
  176. 1730 mv=mv+1:p=516:gosub60:print""right$(str$(mv),len(str$(mv))-1)"[146]";
  177. 1740 slv$="":for x=1 to 10:slv$=slv$+ch$(x):next
  178. 1750 if slv$=win$ then1780
  179. 1760 if sol=1 then1490
  180. 1770 goto1430
  181. 1780 if sol=1 then1800
  182. 1790 msg$="congratulations !![146]":p1=850:gosub1860
  183. 1800 poke781,21:sys59903:poke198,0:p=851:gosub60:print"try again [y/n]: ";
  184. 1810 get yn$:if yn$<>"y" and yn$<>"n" thenyn$="":goto1810
  185. 1820 print yn$:pokev+21,0
  186. 1830 if yn$="y" then run1420
  187. 1840 run
  188. 1850 rem - message rtn.
  189. 1860 p=p1+80:for x=1 to 5:gosub60:print msg$;:for tm=1 to 500:next tm
  190. 1870 poke781,23:sys59903:fortm=1to500:nexttm,x
  191. 1880 print"":return
  192. 1890 rem - set up screen
  193. 1900 p=95:gosub60:print"juggernaut[146]";
  194. 1910 p=402:gosub60:printl1$:p=p+40:gosub60:printl1$
  195. 1920 for x=1 to 3:gosub1930:next:goto1940
  196. 1930 printspc(2)l3$;spc(28)l3$:return
  197. 1940 p=p+1